home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programmierung
/
Power-Programmierung (Tewi)(1994).iso
/
magazine
/
nan_news
/
toolkit
/
mouse1.prg
< prev
next >
Wrap
Text File
|
1991-08-17
|
23KB
|
863 lines
/*
* File......: MOUSE1.PRG
* Author....: Robert DiFalco and Leo Letendre
* Date......: $Date: 17 Aug 1991 15:34:52 $
* Revision..: $Revision: 1.5 $
* Log file..: $Logfile: E:/nanfor/src/mouse1.prv $
*
* This is an original work by Robert DiFalco and is placed in the
* public domain.
*
* Modification history:
* ---------------------
*
* $Log: E:/nanfor/src/mouse1.prv $
*
* Rev 1.5 17 Aug 1991 15:34:52 GLENN
* Don Caton fixed some spelling errors in the doc
*
* Rev 1.4 15 Aug 1991 23:06:24 GLENN
* Forest Belt proofread/edited/cleaned up doc
*
* Rev 1.3 17 Jul 1991 22:28:40 GLENN
* Leo fixed a potential bug in ft_mcursor().
*
* Rev 1.2 27 May 1991 13:40:30 GLENN
* Leo Letendre sent me a revision of MOUSE1.PRG where he built in support
* for a three-button mouse, and revised the "double click" detection
* algorithm.
*
* Brought in compliance with new ft_int86().
*
* Rev 1.1 11 May 1991 00:16:48 GLENN
* ft_mgetpos() had a bug where the x and y coordinates were reversed.
* Changed x coordinate to aRegs[3] and y coordinate to aRegs[4], just
* like in ft_msetpos().
*
* Rev 1.0 01 Apr 1991 01:01:48 GLENN
* Nanforum Toolkit
*
*/
#include "FTINT86.CH"
static nMouseX, nMouseY
static nHorMcks, nVerMcks
static aReg[INT86_MAX_REGS]
static lCrsState
#ifdef FT_TEST
FUNCTION MAIN()
local nX, nY, cSavClr
local nButCntR:=0, nButCntL:=0
local cSavScr := savescreen( 0, 0, maxrow(), maxcol() )
if empty( FT_MRESET() )
@ maxrow(), 0 say "Mouse driver is not installed!"
return ""
endif
* ..... Set up the screen
cSavClr := setcolor( "w/n" )
@ 0,0,maxrow(),maxcol() box "░░░░░░░░░"
setcolor( "GR+/RB" )
scroll( 7,2,19,63,0 )
@ 7,2 to 19,63
@ 16, 10 to 18, 40 double
setcolor( "N/W" )
@ 17, 11 say " Double Click here to Quit "
setcolor( "GR+/RB" )
* ..... Start the demo
FT_MSHOWCRS()
do while .t.
nX := nY := 0
devpos( 9, 10 )
devout( "FT_MMICKEYS:" )
FT_MMICKEYS( @nX, @nY )
devout( nX )
devout( nY )
devpos( 10, 10 )
devout( "FT_MGETPOS :" )
DEVOUT( FT_MGETPOS( @nX, @nY ) )
devout( nX )
devout( nY )
devpos( 11, 10 )
devout( "FT_MGETX :" )
DEVOUT( FT_MGETX() )
devpos( 12, 10 )
devout( "FT_MGETY :")
DEVOUT( FT_MGETY() )
devpos( 13, 10 )
devout( "FT_MBUTPRS :" )
DEVOUT( FT_MBUTPRS(1,@nButCntR) )
DEVOUT( FT_MBUTPRS(0,@nButCntL) )
DEVOUT( nButCntL )
DEVOUT( nButCntR )
devpos( 14, 10 )
devout( "FT_MBUTREL :" )
DEVOUT( FT_MBUTREL(1) )
if FT_MINREGION( 17, 11, 17, 39 )
if FT_MDBLCLK()
exit
endif
endif
enddo
FT_MHIDECRS()
setcolor( cSavClr )
restscreen( 0, 0, maxrow(), maxcol(), cSavScr )
devpos( maxrow(), 0 )
RETURN nil
#endif
/*
* $DOC$
* $FUNCNAME$
* FT_MRESET()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Reset mouse driver and return status of mouse
* $SYNTAX$
* FT_MRESET() -> nMouseStatus
* $ARGUMENTS$
* NONE
* $RETURNS$
* An integer representing the mouse status (0 == mouse not installed)
* $DESCRIPTION$
* Resets the mouse driver and returns mouse status. Use FT_MSHOWCRS()
* to display the mouse cursor.
* $EXAMPLES$
* IF Empty( FT_MRESET() )
* ? "No mouse driver is installed"
* ENDIF
* $SEEALSO$
* FT_MSHOWCRS()
* $END$
*/
FUNCTION FT_MRESET()
aReg[1] := 0 // set mouse function call 0
FT_INT86( 51, aReg ) // execute mouse interrupt
RETURN aReg[1] // return status code
/* $DOC$
* $FUNCNAME$
* FT_MCURSOR()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Set the mouse cursor
* $SYNTAX$
* FT_MCURSOR( [ <lState> ] ) -> lCursorState
* $ARGUMENTS$
* <lState> is a logical indicating whether to set the mouse cursor on.
* .T. - set mouse cursor on
* .F. - set mouse cursor off
* If omitted, no change is made to cursor state
* $RETURNS$
* A logical indicating the previous mouse cursor state.
* $DESCRIPTION$
* This function works like most Clipper state functions. If no value
* is sent to FT_MCURSOR() it will return the state of the mouse cursor.
* $EXAMPLES$
* IF !( FT_MCURSOR() )
* FT_MCURSOR( .T. )
* ENDIF
* $END$
*/
FUNCTION FT_MCURSOR( lState )
local lSavState := lCrsState
if VALTYPE(lState)="L"
if ( lCrsState := lState )
FT_MSHOWCRS()
else
FT_MHIDECRS()
endif
ENDIF
RETURN lSavState
/* $DOC$
* $FUNCNAME$
* FT_MSHOWCRS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Increment internal cursor flag and display mouse cursor
* $SYNTAX$
* FT_MSHOWCRS() -> NIL
* $ARGUMENTS$
* NONE
* $RETURNS$
* NIL
* $DESCRIPTION$
* Displays the mouse cursor. Make sure to turn the mouse cursor off
* when redrawing screens. The mouse cursor dutifully saves the screen
* under it, so if you draw over the mouse cursor it will create a "hole"
* in your screen when you move the mouse cursor.
* $EXAMPLES$
* IF Empty( FT_MRESET() )
* FT_MSHOWCRS()
* ENDIF
* $SEEALSO$
* FT_MHIDECRS()
* $END$
*/
FUNCTION FT_MSHOWCRS()
aReg[1] := 1 // set mouse function call 1
FT_INT86( 51, aReg ) // execute mouse interrupt
lCrsState := .t.
RETURN NIL // no output from function
/*
* $DOC$
* $FUNCNAME$
* FT_MHIDECRS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Decrement internal mouse cursor flag and hide mouse cursor
* $SYNTAX$
* FT_MHIDECRS() -> NIL
* $ARGUMENTS$
* NONE
* $RETURNS$
* NIL
* $DESCRIPTION$
* Hides the mouse cursor. Make sure to turn the mouse cursor off when
* redrawing screens. The mouse cursor dutifully saves the screen
* under it, so if you draw over the mouse cursor it will create a
* "hole" in your screen when you move the mouse cursor.
* $EXAMPLES$
* FT_MHIDECRS()
* @ 10, 10 to 20, 20
* FT_MSHOWCRS()
* $SEEALSO$
* FT_MSHOWCRS()
* $END$
*/
FUNCTION FT_MHIDECRS() // decrement internal cursor flag and hide cursor
aReg[1] := 2 // set mouse function call 2
FT_INT86( 51, aReg ) // execute mouse interrupt
lCrsState := .f.
RETURN NIL // no output from function
/*
* $DOC$
* $FUNCNAME$
* FT_MGETPOS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Get mouse cursor position and button status
* $SYNTAX$
* FT_MGETPOS( @<nX>, @<nY> ) -> nButtonStatus
* $ARGUMENTS$
* <nX> is a variable that will receive the mouse X position. It must
* be passed by reference.
*
* <nY> is a variable that will receive the mouse Y position. It must
* be passed by reference.
* $RETURNS$
* an integer representing button status
*
* - 0 for no button pressed
* - 1 for left pressed
* - 2 for right pressed
* - 3 for left and right pressed
* - 4 for middle pressed
* - 5 for left and middle pressed
* - 6 for right and middle pressed
* - 0 for all three buttons pressed
* $DESCRIPTION$
* Loads cursor position into x and y coordinates passed by reference and
* returns the button status.
* $EXAMPLES$
* LOCAL nX, nY
* LOCAL nButton := FT_MGETPOS( @nX, @nY )
* ? "Mouse Row :", nX
* ? "Mouse Column :", nY
* ? "Button Status:", nButton
* $SEEALSO$
* FT_MSETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY()
* $END$
*/
FUNCTION FT_MGETPOS( nX, nY )
nX := if( nX == NIL, 0, nX )
nY := if( nY == NIL, 0, nX )
aReg[1] := 3 // set mouse function call 3
FT_INT86( 51, aReg ) // execute mouse interrupt
nX := nMouseX := aReg[4] // store new x-coordinate
nY := nMouseY := aReg[3] // store new y-coordinate
RETURN aReg[2] // return button status
/* $DOC$
* $FUNCNAME$
* FT_MGETX()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Get mouse cursor row position
* $SYNTAX$
* FT_MGETX() -> nRowPos
* $ARGUMENTS$
* NONE
* $RETURNS$
* Row position of mouse
* $DESCRIPTION$
* Retrieves mouse's row position
* $EXAMPLES$
* ? FT_MGETX()
* $SEEALSO$
* FT_MDEFCRS() FT_MGETPOS() FT_MGETY()
* $END$
*/
FUNCTION FT_MGETX()
FT_MGETPOS()
RETURN int( nMouseX / 8 )
/*
* $DOC$
* $FUNCNAME$
* FT_MGETY()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Get mouse cursor column position
* $SYNTAX$
* FT_MGETY() -> nColPos
* $ARGUMENTS$
* NONE
* $RETURNS$
* Column position of mouse.
* $DESCRIPTION$
* Retrieves mouse's column position.
* $EXAMPLES$
* ? FT_MGETY()
* $SEEALSO$
* FT_MDEFCRS() FT_MGETPOS() FT_MGETX()
* $END$
*/
FUNCTION FT_MGETY()
FT_MGETPOS()
RETURN int( nMouseY / 8 )
/*
* $DOC$
* $FUNCNAME$
* FT_MSETPOS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Position the mouse cursor
* $SYNTAX$
* FT_MSETPOS( <nX>, <nY> ) -> NIL
* $ARGUMENTS$
* <nX> is the desired mouse row.
*
* <nY> is the desired mouse column.
* $RETURNS$
* NIL
* $DESCRIPTION$
* Positions mouse cursor on screen.
* $EXAMPLES$
* FT_MSETPOS( 10, 20 ) // position mouse cursor at row 10, col 20
* $SEEALSO$
* FT_MGETPOS() FT_MDEFCRS() FT_MGETX() FT_MGETY()
* $END$
*/
FUNCTION FT_MSETPOS( nX, nY ) // set mouse cursor location
aReg[1] := 4 // set mouse function call 4
aReg[3] := nY // assign new x-coordinate
aReg[4] := nX // assign new y-coordinate
FT_INT86( 51, aReg ) // execute mouse interrupt
RETURN NIL // no function output
/*
* $DOC$
* $FUNCNAME$
* FT_MXLIMIT()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Set vertical bounds of mouse travel
* $SYNTAX$
* FT_MXLIMIT( <nX1>, <nX2> ) -> NIL
* $ARGUMENTS$
* <nX1> is the top row limit.
*
* <nX2> is the bottom row limit.
* $RETURNS$
* NIL
* $DESCRIPTION$
* Set maximum vertical bounds of mouse.
* $EXAMPLES$
* FT_MXLIMIT( 10, 20 )
* $SEEALSO$
* FT_MYLIMIT() FT_MINREGION()
* $END$
*/
FUNCTION FT_MXLIMIT( nXMin, nXMax ) // set vertical minimum and maximum coordinates
aReg[1] = 7 // set mouse function call 7
aReg[3] = nXMin // load vertical minimum parameter
aReg[4] = nXMax // load vertical maximum parameter
FT_INT86( 51, aReg ) // execute mouse interrupt
RETURN NIL
/*
* $DOC$
* $FUNCNAME$
* FT_MYLIMIT()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Set horizontal bounds of mouse travel
* $SYNTAX$
* FT_MYLIMIT( <nY1>, <nY2> ) -> NIL
* $ARGUMENTS$
* <nY1> is the left column limit.
*
* <nY2> is the right column limit.
* $RETURNS$
* NIL
* $DESCRIPTION$
* Set maximum horizontal bounds of mouse.
* $EXAMPLES$
* FT_MYLIMIT( 10, 20 )
* $SEEALSO$
* FT_MXLIMIT() FT_MINREGION()
* $END$
*/
FUNCTION FT_MYLIMIT( nYMin, nYMax ) // set horizontal minimum and maximum coordinates
aReg[1] = 8 // set mouse function call 8
aReg[3] = nYMin // load horz minimum parameter
aReg[4] = nYMax // load horz maximum parameter
FT_INT86( 51, aReg ) // execute mouse interrupt
RETURN NIL // no function output
/*
* $DOC$
* $FUNCNAME$
* FT_MBUTPRS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Retrieve button press status
* $SYNTAX$
* FT_MRESET( <nButton> [, @nButPrs [, @nX [, @nY] ] ] ) -> nButStatus
* $ARGUMENTS$
* <nButton> is the mouse button number:
*
* 0 - Left Button
* 1 - Right Button
* 2 - Middle Button [if applicable]
*
* <nButPrs> is the number of times the specified button was pressed
* since the last call to this routine. PASSED BY REFERENCE.
* <nX> is the X position of the cursor when the last press occurred. PASSED
* BY REFERENCE.
* <nY> is the Y position of the cursor when the last press occurred. PASSED
* BY REFERENCE.
*
* $RETURNS$
* An integer representing the button status:
*
* 0 - no buttons pressed
* 1 - left button pressed
* 2 - right button pressed
* 3 - left and right pressed
* 4 - middle pressed
* 5 - left and middle pressed
* 6 - middle and right buttons pressed
* 7 - all 3 buttons pressed
* $DESCRIPTION$
* Retrieves the mouse button status.
* $EXAMPLES$
* IF Empty( FT_MBUTPRS(1) )
* ? "No Item selected"
* ENDIF
* $SEEALSO$
* FT_MBUTREL() FT_MDBLCLK()
* $END$
*/
FUNCTION FT_MBUTPRS( nButton, nButPrs, nX, nY ) // get button press information
aReg[1] := 5 // set mouse function call 5
aReg[2] := nButton // pass parameter for left or right button
FT_INT86( 51, aReg ) // execute mouse interrupt
nButPrs := aReg[2] // store updated press count
nX := aReg[4] // x-coordinate at last press
nY := aReg[3] // y-coordinate at last press
RETURN aReg[1] // return button status
/* $DOC$
* $FUNCNAME$
* FT_MBUTREL()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Get mouse button release information
* $SYNTAX$
* FT_MBUTREL( nButton [, @nButRel [, @nX [, @nY] ] ]) -> nBStat
* $ARGUMENTS$
* <nButton> is the mouse button number
* 0 - Left Button
* 1 - Right Button
* 2 - Middle Button [if applicable]
*
* <nButRel> is the number of times the specified button was released
* since the last call to this routine. PASSED BY REFERENCE.
*
* <nX> is the X position of the cursor when the last release occurred.
* PASSED BY REFERENCE.
*
* <nY> is the Y position of the cursor when the last release occurred.
* PASSED BY REFERENCE.
* $RETURNS$
* <nBStat> - an integer representing button release status
* 0 - None
* 1 - Left
* 2 - Right
* 3 - Middle
* $DESCRIPTION$
* This function returns the release status of the mouse buttons.
* $EXAMPLES$
* IF( FT_MBUTREL( 0 ) == 1 )
* ? "Left button released"
* ENDIF
* $SEEALSO$
* FT_MBUTPRS() FT_MDBLCLK()
* $END$
*/
FUNCTION FT_MBUTREL( nButton, nButRel, nX, nY ) // get button release information
aReg[1] := 6 // set mouse function call 6
aReg[2] := nButton // pass parameter for left or right button
FT_INT86( 51, aReg ) // execute mouse interrupt
nButRel := aReg[2] // store updated release count
nX := aReg[4] // x-coordinate at last release
nY := aReg[3] // y-coordinate at last release
RETURN aReg[1] // return button status
/*
* $DOC$
* $FUNCNAME$
* FT_MDEFCRS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Define the mouse cursor
* $SYNTAX$
* FT_MDEFCRS( <nCrsType>, <nScrMask>, <nCrsMask> ) -> NIL
* $ARGUMENTS$
* <nCrsType> is the cursor type.
*
* <nScrMask> is the screen mask.
*
* <nCrsMask> is the cursor mask.
* $RETURNS$
* NIL
* $DESCRIPTION$
* Defines the cursor type
* $END$
*/
FUNCTION FT_MDEFCRS( nCurType, nScrMask, nCurMask ) // define text cursor type and masks
aReg[1] = 10 // set mouse function call 10
aReg[2] = nCurType // load cursor type parameter
aReg[3] = nScrMask // load screen mask value
aReg[4] = nCurMask // load cursor mask value
FT_INT86( 51, aReg ) // execute mouse interrupt
RETURN NIL // no function output
/*
* $DOC$
* $FUNCNAME$
* FT_MMICKEYS()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Get mickeys
* $SYNTAX$
* FT_MMICKEYS( @<nX>, @<nY> ) -> NIL
* $ARGUMENTS$
* <nX> is a variable that will receive the vertical mickey count.
*
* <nY> is a variable that will receive the horizontal mickey count.
* $RETURNS$
* NIL
* $DESCRIPTION$
* <nX> and <nY> must be passed by reference to receive
* the mouse position in Mickeys.
* $EXAMPLES$
* FT_MMICKEYS( @nX, @nY )
* ? nX
* ? nY
* $END$
*/
FUNCTION FT_MMICKEYS( nX, nY ) // read mouse motion counters
aReg[1] = 11 // set mouse function call 11
FT_INT86( 51, aReg ) // execute mouse interrupt
nX := nHorMcks := aReg[3] // store horizontal motion units
nY := nVerMcks := aReg[4] // store vertical motion units
RETURN NIL // no function output
/*
* $DOC$
* $FUNCNAME$
* FT_MDBLCLK()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Return true if a double click was detected
* $SYNTAX$
* FT_MDBFCLK( [ <nClick> [, <nButton> [, <nInterval> [, <nRow> [, <nCol>;
* [, <nTime> ] ] ] ] ] ] ) -> lIsDoubleClk
* $ARGUMENTS$
* <nClick> is a numeric value. If it is zero FT_MDBLCLK() will not
* check for the first press but rather will simply wait the
* specified period for a single press. This is useful if this
* routine is called from one which in turn responded to a button
* press. If it is not present or not equal to 0, then FT_MDBLCLK()
* will wait for two presses of the specified button.
*
* <nButton> is the mouse button number
* 0 - Left Button
* 1 - Right Button
* 2 - Middle Button [if applicable]
*
* <nInterval> is the interval to wait for the first click if requested
* and the time to wait for the second. If not present then defaults
* to 0.5 second.
*
* <nRow> is the row number for the mouse cursor location for a double click
* to be valid. If not present then the current position is taken as
* the valid location.
*
* <nCol> is the column number for the mouse cursor location for a double
* click to be valid. If not present, then the current position is
* taken as the valid location.
*
* <nTime> is an optional start time for the waiting period for the first
* click (of either one or two requested). If not given then the
* time is set at entry into this routine. This is useful when this
* routine is called from another routine which was called in
* response to a mouse click but needs to know if a double click
* has occurred
* $RETURNS$
* .T. if a double click was detected.
* $DESCRIPTION$
* This is a mouse meta function that checks for the presence
* of a double click.
* $EXAMPLES$
* IF FT_MISREGION( 10, 10, 11, 20 ) .AND.;
* FT_MDBLCLK(0,1,,FT_MGETX(),FT_MGETY()) && double click, right button
* && at current location with
* && default interval
*
* MnuItem1()
* ENDIF
* $SEEALSO$
* FT_MBUTPRS() FT_MBUTREL()
* $END$
*/
FUNCTION FT_MDBLCLK( nClick, nButton, nInterval, nRow, nCol, nStart )
LOCAL nVert, nHorz // local row and col coordinates
LOCAL lDouble:=.F. // double click actually occurred
LOCAL lDone // loop flag
LOCAL nPrs // number of presses which occurred
* Initialize any empty arguments
if nClick=NIL
nClick=1
endif
if nButton=NIL
nButton=0
endif
if nRow=NIL
nRow=FT_MGETX()
endif
if nCol=NIL
nCol=FT_MGETY()
endif
if nInterval=NIL
nInterval=0.5
endif
if nStart=NIL
nStart=seconds()
endif
nVert=nRow
nHorz=nCol
lDouble:=lDone:=nClick==0
// Wait for first press if requested
do while !lDone
FT_MBUTPRS( nButton, @nPrs, @nVert, @nHorz )
nVert=INT(nVert/8)
nHorz=INT(nHorz/8)
lDouble=(nPrs>0)
ldone= seconds() - nStart >= nInterval .or. lDouble
enddo
// if we have not moved then keep the preliminary double click setting
lDouble=lDouble.and.(nVert=nRow.and.nHorz=nCol)
// change start time if we waited for first click. nInterval is the
// maximum time between clicks not the total time for two clicks if
// requested.
if nClick>0
nStart=seconds()
endif
// If we have fulfilled all of the requirements then wait for second click
if lDouble
lDouble:=lDone:=.F.
do while !lDone
FT_MBUTPRS( nButton, @nPrs, @nVert, @nHorz )
nVert=INT(nVert/8)
nHorz=INT(nHorz/8)
lDouble=(nPrs>0)
lDone= seconds() - nStart >= nInterval .or. lDouble
enddo
// make sure we haven't moved
lDouble=lDouble.and.(nVert=nRow.and.nHorz=nCol)
endif
RETURN lDouble
/*
* $DOC$
* $FUNCNAME$
* FT_MINREGION()
* $CATEGORY$
* Keyboard/Mouse
* $ONELINER$
* Test if the mouse cursor is in the passed region
* $SYNTAX$
* FT_MINREGION( <nT>, <nL>, <nB>, <nR> ) -> lInRegion
* $ARGUMENTS$
* <nT>, <nL> <nB> <nR> are the four corners of the screen region.
* $RETURNS$
* .T. if mouse is in specified region.
* $DESCRIPTION$
* This function will check to see if the mouse cursor is
* within the confines of the specified region.
* $EXAMPLES$
* IF FT_MINREGION( 10, 10, 11, 20 )
* nChoice := 1
* ENDIF
* $SEEALSO$
* FT_MXLIMIT() FT_MYLIMIT() FT_MINREGION()
* $END$
*/
FUNCTION FT_MINREGION( nTR, nLC, nBR, nRC )
RETURN ( FT_MGETX() >= nTR .and. FT_MGETX() <= nBR .and. ;
FT_MGETY() >= nLC .and. FT_MGETY() <= nRC )